Meeting Pearls 4/Meeting Pearls Vol. IV (1996)(GTI - Schatztruhe)[!].iso/Pearls/dev/Oberon/OberonV4/system/IFF.Mod

Oberon Text | 1996-03-19 | 5KB | 182 lines

Syntax20b.Scn.Fnt
ParcElems
Alloc
Syntax24b.Scn.Fnt
Syntax10.Scn.Fnt
Syntax10b.Scn.Fnt
Syntax20i.Scn.Fnt
FoldElems
(* AMIGA *)
MODULE IFF; (* Ralf Degner 4.08.1995 *)
IMPORT
    i:=AmigaIFFParse, a:=AmigaIFF, AmigaDos, Display, Viewers, Oberon, Texts,
    PictureFrames, Pictures, MenuViewers, TextFrames, Log;
    FileHan: AmigaDos.FileHandlePtr;
    Handler: i.IFFHandlePtr;
    FileOpen: BOOLEAN;
(* NEVER leave an open IFF-File *)
(* If a PROCEDURE opens an IFF-File, it MUST close the File before it ends *)
(* Close IFF-File, uses AmigaDos direct *)
PROCEDURE CloseFile();
    VAR Dummy: BOOLEAN;
BEGIN
    IF FileOpen THEN i.CloseIFF(Handler); Handler:=NIL; END;
    IF FileHan#0 THEN Dummy:=AmigaDos.Close(FileHan); FileHan:=0; END;
    IF Handler#NIL THEN i.FreeIFF(Handler); Handler:=NIL END;
    FileOpen:=FALSE;
END CloseFile;
(* Open IFF-File, uses AmigaDos direct *)
PROCEDURE OpenFile(filemode: LONGINT; mode: SET; Name: ARRAY OF CHAR);
BEGIN
    FileHan:=AmigaDos.Open(Name, filemode);
    IF FileHan#0 THEN
        Handler:=i.AllocIFF();
        IF Handler#NIL THEN
            Handler.stream:=FileHan;
            i.InitIFFasDOS(Handler);
            IF i.OpenIFF(Handler, mode)=0 THEN FileOpen:=TRUE END
        END
    END;
    IF ~FileOpen THEN CloseFile() END
END OpenFile;
(* Get selected Frame *)
PROCEDURE GetFrame(VAR f: Display.Frame): BOOLEAN;
    VAR v: Viewers.Viewer;
BEGIN
    IF Oberon.Par.frame=Oberon.Par.vwr.dsc THEN
        IF (Oberon.Par.frame # NIL) THEN
            f:=Oberon.Par.frame.next;
            RETURN TRUE
        END
    ELSE
        v:=Oberon.MarkedViewer();
        IF (v.dsc # NIL) & (v.dsc.next # NIL) THEN
            f:=v.dsc.next;
            RETURN TRUE
        END
    END;
    RETURN FALSE;
END GetFrame;
(* Get File-Name *)
PROCEDURE GetName(VAR Name: ARRAY OF CHAR): BOOLEAN;
        S: Texts.Scanner;
        text: Texts.Text;
        beg, end, time: LONGINT;
BEGIN
    Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos);
    Texts.Scan(S);
    IF S.class=Texts.Char THEN
        IF S.c="^" THEN
            Oberon.GetSelection(text, beg, end, time);
            IF time=-1 THEN RETURN FALSE; END;
            Texts.OpenScanner(S, text, beg);
            Texts.Scan(S)
        ELSE
            RETURN FALSE
        END
    END;
    IF ((S.class=Texts.Name) OR (S.class=Texts.String)) & (S.len<128) THEN
        COPY(S.s, Name);
        RETURN TRUE
    ELSE
        RETURN FALSE
END GetName;
(* Print Info of a Picture *)
PROCEDURE PrintInfo(P: Pictures.Picture);
BEGIN
    Log.Str("Width="); Log.Int(P.width);
    Log.Str("  Height="); Log.Int(P.height);
    Log.Str("  Depth="); Log.Int(P.depth);
    Log.Ln;
END PrintInfo;
(* Load Display-Colors *)
PROCEDURE LoadColors*;
    VAR Name: ARRAY 128 OF CHAR;
BEGIN
    IF GetName(Name) THEN
        OpenFile(AmigaDos.oldFile, i.read, Name);
        IF FileOpen THEN
            a.LoadDisplayColors(Handler);
            CloseFile()
        END
END LoadColors;
(* Store Display-Colors *)
PROCEDURE StoreColors*;
        Name: ARRAY 128 OF CHAR;
        error: LONGINT;
BEGIN
    IF GetName(Name) THEN
        OpenFile(AmigaDos.newFile, i.write, Name);
        IF FileOpen THEN
            IF i.PushChunk(Handler, a.ILBM, a.FORM, i.sizeUnknown)=0 THEN
                a.StoreBMHD(Handler, 0, 0, 0, a.cmpNone);
                a.StoreDisplayColors(Handler);
                error:=i.PopChunk(Handler);
            END;
            CloseFile()
        END
END StoreColors;
(* Make Screen-SnapShot *)
PROCEDURE StoreDisplay*;
    VAR Name: ARRAY 128 OF CHAR;
BEGIN
    IF GetName(Name) THEN
        OpenFile(AmigaDos.newFile, i.write, Name);
        IF FileOpen THEN
            a.StoreDisplayAsILBM(Handler);
            CloseFile()
        END
END StoreDisplay;
(* Store Picture as ILBM *)
PROCEDURE PaintStore*;
        Name: ARRAY 128 OF CHAR;
        f, g: Display.Frame;
BEGIN
    IF GetFrame(g) THEN
        f:=g;
        WITH f: PictureFrames.Frame DO
            IF GetName(Name) THEN
                OpenFile(AmigaDos.newFile, i.write, Name);
                IF FileOpen THEN
                    a.StorePictAsILBM(Handler, f.pict);
                    CloseFile()
                END
            END
        ELSE
        END
END PaintStore;
(* Open IFF with Paint *)
PROCEDURE PaintOpen*;
        Name: ARRAY 128 OF CHAR;
        F: PictureFrames.Frame;
        P: Pictures.Picture;
        V: Viewers.Viewer;
        X, Y :  INTEGER;
BEGIN
    IF GetName(Name) THEN
        OpenFile(AmigaDos.oldFile, i.read, Name);
        IF FileOpen THEN
            P:=a.LoadILBMToPict(Handler);
            CloseFile();
            IF P#NIL THEN
                F:=PictureFrames.NewPicture(P);
                Oberon.AllocateUserViewer(Oberon.Par.vwr.X,X,Y);
                V := MenuViewers.New(TextFrames.NewMenu(Name, "^Paint.Menu.Text"),F, TextFrames.menuH, X, Y);
                PrintInfo(P)
            END
        END
END PaintOpen;
(* Fir Colors of Pictur to Display Colors *)
PROCEDURE PaintFitColors*;
        f, g: Display.Frame;
BEGIN
    IF GetFrame(g) THEN
        f:=g;
        WITH f: PictureFrames.Frame DO
            a.FitColors(f.pict);
        ELSE
        END
END PaintFitColors;
END IFF.
System.Free IFF ~